home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.cs.arizona.edu
/
ftp.cs.arizona.edu.tar
/
ftp.cs.arizona.edu
/
icon
/
newsgrp
/
group97b.txt
/
000013_icon-group-sender _Fri Jul 4 07:51:24 1997.msg
< prev
next >
Wrap
Internet Message Format
|
2000-09-20
|
13KB
Received: from kingfisher.CS.Arizona.EDU by cheltenham.cs.arizona.edu; Tue, 8 Jul 1997 08:45:21 MST
Received: by kingfisher.CS.Arizona.EDU; (5.65v3.2/1.1.8.2/08Nov94-0446PM)
id AA24535; Tue, 8 Jul 1997 08:45:20 -0700
Posted-Date: Fri, 4 Jul 1997 07:51:24 -0500 (CDT)
Date: Fri, 4 Jul 1997 07:51:24 -0500 (CDT)
From: Chris Tenaglia <cdt@post.its.mcw.edu>
To: icon-group@cs.arizona.edu
Subject: 4th of July Sample 1
Message-Id: <Pine.SOL.3.96.970704073852.21094A-100000@post.its.mcw.edu>
Mime-Version: 1.0
Content-Type: TEXT/PLAIN; charset=US-ASCII
Errors-To: icon-group-errors@cs.arizona.edu
Status: RO
Here's a sample program to celebrate this 4th of July with.
It's not a firecracker program, but just yet another menu.
I know, the web seems to make it a moot point but it's a
big chunk of code, and I even use it myself.
This one is nice though, because it only need to be compiled
once. It feeds on menu data files in the format:
This is the title line
pine:Pine Email
ftp:File transfer program
[whoami:Who Am I
?w:Currently logged in users
lynx:Browse the Web
menu games.dat:Games Menu
q:quit
The ? prefix puts the output in a file viewer.
The [ prefix takes small output and puts it in a screen box.
The default menu file is menu.dat but you can like to
submenus as well. There are variables that let you customize
it to your company. You can navigate using the arrows or pressing
the first letter of the entry. It works with most vt emulations
and a few others. And now for the code!
#################### BEGIN PROGRAM ###########################
#
# file : menu.icn
# desc : a generalized menuing system designed for unix
# use : menu menu_data
# : menu_data is a file with the following items
# first line is the title line
# subsequent lines contain verb:Description
# and menus can call other menus
#
# update by what
# 28-apr-1997 tenaglia initial write
#
global company,viewer
procedure main(param)
company := "Medical College of WI"
viewer := "see"
source := param[1] | "menu.dat"
(in := open(source)) | stop("Can't read ",source)
username := getenv("USER")
title := center(read(in),79)
ff := "\"\\f\""
widest := 20
vector := table("")
verbs := []
jects := []
while line := read(in) do
{
action := parse(line,':')[1]
description := parse(line,':')[2]
vector[description] := action
widest <:= *description
put(verbs,action)
put(jects,description)
}
close(in)
widest +:= 2
if *verbs > 20 then stop("Menu data over 20. Too big!")
if widest > 70 then stop("Menu data is too wide!")
every i := 1 to *jects do jects[i] := left(jects[i],widest-2)
x := (80 - widest) / 2
y := (23 - *verbs + 1) / 2
repeat {
write("\e[2J\e[H",company,"| ",&dateline,
" | ",&host," | ",username)
write("\e[1;7m",title,"\e[0m")
uclist(y,x,jects)
writes(at(y+1,x+2),"\e[1m",jects[1],"\e[0m")
i := 1
r := y+1
c := x+2
repeat
{
writes(at(r,c),"\e[1;7m",left(jects[i],widest-2),"\e[0m")
k := getkey()
if k == ("LEFT" | "UP") then
{
or := r
oc := c
oi := i
i -:= 1
r -:= 1
if i < 1 then { i := 1 ; r := y+1 ; next }
writes(at(or,oc),"\e[0m",left(jects[oi],widest-2))
}
if k == ("RIGHT" | "DOWN") then
{
or := r
oc := c
oi := i
i +:= 1
r +:= 1
if i > *jects then { i := *jects ; r := y + *jects ; next }
writes(at(or,oc),"\e[0m",left(jects[oi],widest-2))
}
if *k = 3 then
{
or:= r
oc:= c
oi:= i
i := spin(i,k[2],jects)
r := y + i
(oi = i) | writes(at(or,oc),"\e[0m",left(jects[oi],widest-2))
}
if k == "ENTER" then { choice := i ; break }
if k == "\"?\"" then
{
help()
write("\e[2J\e[H",company," | ",&dateline,
" | ",&host," | ",username)
write("\e[1;7m",title,"\e[0m")
uclist(y,x,jects)
writes(at(y+1,x+2),"\e[1m",jects[1],"\e[0m")
next
}
if k == ff then
{
write("\e[2J\e[H",company," | ",&dateline,
" | ",&host," | ",username)
write("\e[1;7m",title,"\e[0m")
uclist(y,x,jects)
writes(at(y+1,x+2),"\e[1m",jects[1],"\e[0m")
}
}
command := verbs[i]
if command == "q" then
{
while remove("menu.tmp")
stop(at(23,1),"Quit")
}
if any('[]',command) then
{
command := command[2:0] || " >menu.tmp"
system(command)
results := []
most := 0
in := open("menu.tmp")
every line := !in do
{
most <:= *line
if *results < 10 then put(results,line)
}
close(in)
put(results,center("Press <ENTER>",most))
c := (80 - most) / 2
r := 12 - (*results / 2)
uclist(r,c,results)
getch()
}
if match("?",command) then
{
command := command[2:0] || " >menu.tmp"
system(command)
command := viewer || " menu.tmp"
system(command)
} else {
system(command)
}
}
end
#
# spin the menu to find the next match
#
procedure spin(i,k,menu)
max := *menu + 3
old := i
every 1 to max do
{
i +:= 1
if i > *menu then i := 1
if match(map(k),map(menu[i][1])) then return i
}
return old
end
#
# instant help from pressing ?
#
procedure help()
write("\e[2J\e[HThe Easy Menu for Unix")
write("")
write("The menus appear in little boxes and are usable with")
write("most types of VT terminal emulation. You can navigate")
write("between the entries using the arrows or by pressing")
write("the first letter of the entry and then ENTER.")
write("")
write("In some cases the output would normally just role by,")
write("but it was captured to a scratch file and put into a")
write("file viewer. The file viewer recognizes the following")
write("keys:")
write("")
write("SPACE = next page")
write("BACKSPACE = prior page")
write("DOWNARROW = next line")
write("UPARROW = prior line")
write("RIGHTARROW= move/pan right 20 characters")
write("LEFTARROW = move/pan left 20 characters")
write("q = quit")
write("? = displays this help screen")
write("")
write("Press any key to continue")
getch()
end
#
# parse a string into a list with respect to a delimiter
#
procedure parse(line,delims)
static chars
chars := &cset -- delims
tokens := []
line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
return tokens
end
#
# prompt for an input string
#
procedure input(prompt)
writes(prompt)
return read()
end
#
# THIS ROUTINE SETS THE CURSOR TO A GIVEN X (COL) Y(ROW) SCREEN LOCATION
#
procedure at(y,x) # 11p
return "\e[" || y || ";" || x || "f"
end
#
# box input routine for universe client
# requires input and at for screen input
#
procedure ucinput(row,column,prompt)
static ur, ul, lr, ll, vb, hb, gon, goff, device
initial {
device := getenv("TERM")
if match(("vt"|"xt"),device) then
{
ur := "k" # upper right corner
ul := "l" # upper left corner
lr := "j" # lower right corner
ll := "m" # lower left corner
vb := "x" # Vertical bar
hb := "q" # horizontal bar
gon := "\e(0" # graphics mode on
goff := "\e(B" # graphic mode off
} else {
ur := "`" # upper right corner
ul := "_" # upper left corner
lr := "^" # lower right corner
ll := "]" # lower left corner
vb := "2" # Vertical bar
hb := "K" # horizontal bar
gon := "\e[11m" # graphics mode on
goff := "\e[10m" # graphic mode off
}
}
width := *prompt + 2
message := gon || vb || goff || center(prompt,width) || gon || vb || goff
writes(at(row,column),gon,ul,repl(hb,width),ur,goff)
writes(at(row+1,column),message)
writes(at(row+2,column),gon,vb,repl(" ",width),gon,vb,goff)
writes(at(row+3,column),gon,ll,repl(hb,width),lr,goff)
return input(at(row+2,column+3))
end
#
# display a list in a box in universe client
# requires the at video routine
#
procedure uclist(row,column,lines)
static ur, ul, lr, ll, vb, hb, gon, goff, device
initial {
device := getenv("TERM")
if match(("vt"|"xt"),device) then
{
ur := "k" # upper right corner
ul := "l" # upper left corner
lr := "j" # lower right corner
ll := "m" # lower left corner
vb := "x" # Vertical bar
hb := "q" # horizontal bar
gon := "\e(0" # graphics mode on
goff := "\e(B" # graphic mode off
} else {
ur := "`" # upper right corner
ul := "_" # upper left corner
lr := "^" # lower right corner
ll := "]" # lower left corner
vb := "2" # Vertical bar
hb := "K" # horizontal bar
gon := "\e[11m" # graphics mode on
goff := "\e[10m" # graphic mode off
}
}
width := 0
every item := !lines do width <:= *item
width +:= 2
heap := copy(lines)
writes(at(row,column),gon,ul,repl(hb,width),ur,goff)
every point := row+1 to row + *lines do
{
message := gon || vb || goff || center(pop(heap),width) || gon || vb || goff
writes(at(point,column),message)
}
writes(at(point+1,column),gon,ll,repl(hb,width),lr,goff)
end
#
# output a message box and prompt for any key
# requires the at video routines
#
procedure ucmessage(row,column,prompt)
static ur, ul, lr, ll, vb, hb, gon, goff, device
initial {
device := getenv("TERM")
if match(("vt"|"xt"),device) then
{
ur := "k" # upper right corner
ul := "l" # upper left corner
lr := "j" # lower right corner
ll := "m" # lower left corner
vb := "x" # Vertical bar
hb := "q" # horizontal bar
gon := "\e(0" # graphics mode on
goff := "\e(B" # graphic mode off
} else {
ur := "`" # upper right corner
ul := "_" # upper left corner
lr := "^" # lower right corner
ll := "]" # lower left corner
vb := "2" # Vertical bar
hb := "K" # horizontal bar
gon := "\e[11m" # graphics mode on
goff := "\e[10m" # graphic mode off
}
}
width := *prompt + 2
message := gon || vb || goff || center(prompt,width) || gon || vb || goff
writes(at(row,column),gon,ul,repl(hb,width),ur,goff)
writes(at(row+1,column),message)
writes(at(row+2,column),gon,vb,goff,center("Press Any Key",width),gon,vb,goff)
writes(at(row+3,column),gon,ll,repl(hb,width),lr,goff)
return getch()
end
#
# detects keys from a LAWSON UNIVERSE client
#
procedure getkey()
k := getch()
if k == "\x18" then return "F11"
if k == "\d" then return "DEL"
if k == "\n" then return "ENTER"
if k == "\t" then return "TAB"
if k == "\r" then return "RETURN"
(k == "\e") | (return image(k))
k2 := getch()
(k2 == "[") | (k2 == "O") | return image(k || k2)
k3 := getch()
case k2 of
{
"[" : case k3 of {
"A" : return "UP"
"B" : return "DOWN"
"C" : return "RIGHT"
"D" : return "LEFT"
"V" : return "PGUP"
"U" : return "PGDN"
"4" : { getch() ; return "INS" }
default : return image(k || k2 || k3)
}
"O" : case k3 of {
"P" : return "F1"
"Q" : return "F2"
"R" : return "F3"
"S" : return "F4"
"T" : return "F5"
"U" : return "F6"
"V" : return "F7"
"W" : return "F8"
"X" : return "F9"
"Y" : return "F10"
"E" : return "STAB"
"]" : return "HOME"
"^" : return "END"
"o" : return "KP-"
default : return image(k || k2 || k3)
}
default : return image(k || k2 || k3)
}
return "?" || image(k || k2 || k3)
end
#
# pause a sec
#
procedure pause()
rax := ?50
ray := ?20
ucmessage(ray,rax,"Beep!")
end
###################### END OF PROGRAM #########################
Chris Tenaglia (system manager) | The future foretold,
Medical College of Wisconsin | The past explained,
8701 W. Watertown Plank Rd. | The present largely appologized for.
Milwaukee, WI 53226 (414)456-8765 | Organon to the Doctor